home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / STREAM.ASM < prev    next >
Encoding:
Assembly Source File  |  1993-01-27  |  12.0 KB  |  423 lines
  1. ;* STREAM.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        C stuff recoded in assembly language (phtew!)        *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18. ;*                                    *
  19. ;*                    ``In nomine omnipotentii dei''    *
  20. ;************************************************************************
  21. IDEAL
  22. %PAGESIZE    60, 132
  23. MODEL    medium
  24. LOCALS    @@
  25.  
  26.     INCLUDE    "scheme.ash"
  27.  
  28. CODESEG
  29. ;************************************************************************
  30. ;*            Convert flonum to bignum            *
  31. ;* Calling sequence: flotobig(flo,bigbuf)                *
  32. ;* Where flo:    double-length flonum such that abs(flo)>=1        *
  33. ;*    bigbuf:    pointer to buffer for bignum formation            *
  34. ;************************************************************************
  35. PROC C    flotobig USES si di, @@flo:QWORD, @@bignum:WORD
  36.     LOCAL    @@status:WORD, @@tempbig:QWORD
  37.     push    ds            ; Assume es = ds
  38.     pop    es
  39.     fld    [@@flo]
  40.     ftst
  41.     mov    di, [@@bignum]
  42.     fstsw    [@@status]
  43.     mov    [(BIGDATA di).sign], 0
  44.     mov    ax, [@@status]
  45.     fabs
  46.     sahf
  47.     jnz    @@notzero        ; handle special case
  48. @@zero:
  49.     mov    [(BIGDATA di).len], 1
  50.     mov    [(BIGDATA di).lsw], 0
  51.     jmp    @@done
  52.  
  53. @@notzero:
  54.     jnc    @@positive
  55.     inc    [(BIGDATA di).sign]
  56. @@positive:
  57.     fxtract
  58.     fxch    st(1)
  59.     fistp    [@@status]        ; get the exponent
  60.     cmp    [@@status], 64
  61.     jg    @@bigenough
  62.     fstp    st(0)            ; drop the mantissa
  63.     fld    [@@flo]
  64.     lea    si, [@@tempbig+(TYPE QWORD)]
  65.     fabs
  66.     mov    cx, 4            ; 4 words maximum
  67.     fistp    [@@tempbig]
  68. @@truncateloop:
  69.     dec    si
  70.     dec    si
  71.     cmp    [WORD si], 0
  72.     loopz    @@truncateloop
  73. @@mswfound:
  74.     jz    @@zero
  75.     lea    si, [@@tempbig]
  76.     inc    cx
  77.     mov    [(BIGDATA di).len], cx
  78.     lea    di, [(BIGDATA di).lsw]
  79.     rep    movsw
  80.     jmp    @@done
  81.  
  82. @@bigenough:
  83.     mov    bx, [@@status]        ; get the exponent
  84.     lea    ax, [bx-1]
  85.     and    ax, 0fh            ; keep roundoff
  86.     inc    ax
  87.     add    ax, 30h            ; ax is in range 31h ... 40h
  88.     mov    [@@status], ax
  89.     fild    [@@status]
  90.     sub    bx, ax
  91.     mov    cl, 4
  92.     fxch    st(1)
  93.     shr    bx, cl
  94.     mov    ax, bx
  95.     fscale
  96.     add    bx, (TYPE QWORD) / 2    ; sizes are in words
  97.     mov    [(BIGDATA di).len], bx
  98.     lea    si, [(BIGDATA di).lsw] ; fill in 0's
  99.     fstp    st(1)            ; drop the exponent
  100. @@padloop:
  101.     or    ax, ax
  102.     jz    @@putmsw
  103.     mov    [WORD si], 0
  104.     inc    si
  105.     inc    si
  106.     dec    ax
  107.     jmp    @@padloop
  108. @@putmsw:
  109.     fistp    [QWORD si]
  110. @@done:
  111.     ret
  112. ENDP    flotobig
  113.  
  114. ;************************************************************************
  115. ;*        Move bytes from buffer to allocated Scheme block    *
  116. ;* Calling sequence: toblock(reg,offs,buf,q)                *
  117. ;* Where reg:    Scheme register pointing to block            *
  118. ;*    offs:    Offset into block to begin transfer            *
  119. ;*    buf:    Buffer pointer                        *
  120. ;*    len:    Number of bytes to move                    *
  121. ;************************************************************************
  122. PROC C    toblock    USES si di, @@reg:WORD, @@offset:WORD, @@buf:WORD, @@len:WORD
  123.     mov    bx, [@@reg]        ; Get register address
  124.     mov    di, [(REG bx).disp]
  125.     mov    bx, [(REG bx).page]
  126.     ldpage    es, bx
  127.     add    di, [@@offset]
  128.     mov    si, [@@buf]
  129.     mov    cx, [@@len]
  130.     cld
  131.     rep    movsb
  132.     ret
  133. ENDP    toblock
  134.  
  135. ;************************************************************************
  136. ;*        Give characters from a C string                *
  137. ;* Calling sequence: gvchars(str,len)                    *
  138. ;* Where str:    C string address                    *
  139. ;*    len:    Number of characters to give                *
  140. ;************************************************************************
  141. PROC C    gvchars    USES si di, @@string:WORD, @@len:WORD
  142.     mov    si, [@@string]
  143.     mov    cx, [@@len]
  144.     jcxz    @@given
  145.     cld
  146. @@loop:
  147.     push    cx
  148.     lodsb
  149.     call    givechar C, ax
  150.     pop    cx
  151.     loop    @@loop
  152. @@given:
  153.     ret
  154. ENDP    gvchars
  155.  
  156. ;************************************************************************
  157. ;*    Move characters from block (symbol or string) to print buffer    *
  158. ;* Calling sequence: blk2pbuf(pg,ds,buf,len,ch,display)            *
  159. ;* Where pg:    logical page of the block                *
  160. ;*    ds:    block displacement                    *
  161. ;*    buf:    address of print buffer                    *
  162. ;*    len:    number of chars in the block                *
  163. ;*    ch:    character to escape (| for syms, " for strs)        *
  164. ;*    display: whether to use escape characters            *
  165. ;* Returns the number 2n+s, where n is the number of characters in the    *
  166. ;* print buffer, and s=1 if strange chars were encountered, 0 otherwise.*
  167. ;************************************************************************
  168. PROC C    blk2pbuf USES ds si di, @@page:WORD, @@disp:WORD, @@buf:WORD, @@len:WORD, @@char:WORD, @@display:WORD
  169.     push    ds            ; Assume es = ds
  170.     pop    es
  171.     mov    bx, [@@page]
  172.     shl    bx, 1            ; Put segment of block in ds
  173.     ldpage    ds, bx
  174.     mov    si, [@@disp]
  175.     mov    di, [@@buf]
  176.     mov    cx, [@@len]
  177.     mov    bl, [BYTE @@char]
  178.     mov    bh, [BYTE @@display]
  179.     and    bh, 7fh            ; Save bit in bh for strangeness
  180.     mov    dx, di            ; Save start address of print buffer in dx
  181.     jcxz    @@strange        ; If len=0, mark strangeness
  182.     cmp    bl, '"'            ; are we looking at a string?
  183.     jne    @@loop
  184. @@strange:
  185.     or    bh, 80h            ; Otherwise, mark as strange
  186.     jcxz    @@done            ; If len=0, forget everything else
  187. @@loop:
  188.     lodsb                ; Fetch char from block
  189.     test    bh, 7fh            ; Are we displaying escape chars?
  190.     jz    @@storeit
  191.     cmp    al, bl            ; Does the char need escaping?
  192.     je    @@escapeit
  193.     cmp    al, '\'
  194.     jne    @@storeit
  195. @@escapeit:
  196.     mov    ah, al
  197.     mov    al, '\'            ; store escape character
  198.     stosb
  199.     mov    al, ah            ; Restore char
  200. @@storeit:
  201.     stosb
  202.     test    bh, 80h            ; Do we already know that atom's strange?
  203.     jnz    @@continue
  204.     push    bx
  205.     lea    bx, [es:hicases]
  206.     mov    ah, al
  207.     xlat    [es:hicases]        ; Fetch upper-case equivalent
  208.     pop    bx
  209.     cmp    ah, al
  210.     jne    @@markstrange
  211. DATASEG
  212. @@strangechars DB    " ,'"
  213.     DB    ';":()`'
  214.     DB    13, 12, 11, 10, 9
  215. STRANGECOUNT = $-@@strangechars
  216. CODESEG
  217. @@strangeloop:
  218.     push    cx di
  219.     lea    di, [es:@@strangechars]
  220.     mov    cx, STRANGECOUNT
  221.     repne    scasb
  222.     pop    di cx
  223.     jne    @@continue
  224. @@markstrange:
  225.     or    bh, 80h            ; Mark strange bit
  226. @@continue:
  227.     loop    @@loop
  228. @@done:
  229.     mov    [BYTE es:di], 0        ; Put null at end of string
  230.     mov    ax, di            ; Return 2*(# of chars in string)+strangeness
  231.     sub    ax, dx
  232.     shl    bh, 1            ; get strangeness in carry
  233.     rcl    ax, 1
  234.     ret
  235. ENDP    blk2pbuf
  236.  
  237. ;************************************************************************
  238. ;* Load bignum block with long integer                    *
  239. ;* Calling sequence:        putlong(reg,longi)            *
  240. ;* Where reg:    register pointing to a bignum block            *
  241. ;*    longi: 32-bit integer to store                    *
  242. ;************************************************************************
  243. PROC C    putlong    uses es di, @@reg:WORD, @@long:DWORD
  244.     mov    di, [@@reg]
  245.     mov    bx, [(REG di).page]
  246.     ldpage    es, bx
  247.     mov    di, [(REG di).disp]
  248.     add    di, OFFSET (TYPE BIGDEF).data.sign
  249.     mov    bx, [WORD LOW @@long]
  250.     mov    cx, [WORD HIGH @@long]
  251.     xor    al, al        ; Sign byte - default positive
  252.     or    cx, cx
  253.     jns    @@positive
  254.     inc    al        ; Otherwise, set sign negative
  255.     not    cx        ; negate longint
  256.     neg    bx
  257.     sbb    cx, -1
  258. @@positive:
  259.     cld
  260.     stosb            ; Store sign byte
  261.     mov    ax, bx        ; Store least significant word
  262.     stosw
  263.     jcxz    @@notsolong
  264.     mov    ax, cx
  265.     stosw
  266. @@notsolong:
  267.     ret
  268. ENDP    putlong
  269.  
  270. ;************************************************************************
  271. ;*    Move string bytes from one part of PCS memory to another    *
  272. ;* Calling sequence: msubstr(to_reg, from_reg, start, end)        *
  273. ;* Where to_reg:register pointing to destination string            *
  274. ;*    from_reg:register pointing to source string            *
  275. ;*    start:    offset at which to start copying            *
  276. ;*    end:    byte after the last to be copied            *
  277. ;************************************************************************
  278. PROC C    msubstr    USES ds si di, @@toreg:WORD, @@fromreg:WORD, @@start:WORD, @@end:WORD
  279.     mov    di, [@@toreg]
  280.     mov    si, [@@fromreg]
  281.     mov    ax, [@@start]
  282.     mov    cx, [@@end]
  283.     mov    bx, [(REG di).page]
  284.     mov    di, [(REG di).disp]
  285.     ldpage    es, bx
  286.     add    di, OFFSET (TYPE STRDEF).buffer
  287.     mov    bx, [(REG si).page]
  288.     mov    si, [(REG si).disp]
  289.     ldpage    ds, bx
  290.     add    si, OFFSET (TYPE STRDEF).buffer
  291.     add    si, ax            ; Point ds:si to start of substring
  292.     sub    cx, ax            ; Set number of bytes to move
  293.     cld
  294.     rep    movsb
  295.     ret
  296. ENDP    msubstr
  297.  
  298. ;************************************************************************
  299. ;*    Compare two Scheme bignums or strings for equal?-ness        *
  300. ;* Calling sequence: mcmpstr(rega,regb)                    *
  301. ;* Where rega,regb: registers pointing to objects to be compared    *
  302. ;* Returns 1 if the objects are equal?, 0 otherwise            *
  303. ;************************************************************************
  304. PROC C    mcmpstr    USES ds si di, @@reg1:WORD, @@reg2:WORD
  305.     mov    si, [@@reg1]
  306.     mov    di, [@@reg2]
  307.     mov    bx, [(REG di).page]
  308.     mov    di, [(REG di).disp]
  309.     ldpage    es, bx
  310.     mov    bx, [(REG si).page]
  311.     mov    si, [(REG si).disp]
  312.     ldpage    ds, bx
  313.     sstrlen    cx, <si>, OVERHEAD
  314.     xor    ax, ax            ; Default equality to false
  315.     cld
  316.     repe    cmpsb
  317.     jne    @@false
  318.     inc    ax            ; return true
  319. @@false:
  320.     ret
  321. ENDP    mcmpstr
  322.  
  323. ;************************************************************************
  324. ;*    Load a register with a pointer from Scheme memory        *
  325. ;* Calling sequence: ldreg(reg,pg,ds)                    *
  326. ;* Where reg:    register to be loaded                    *
  327. ;*    pg,ds:    page and displacement of Scheme pointer            *
  328. ;************************************************************************
  329. PROC C    ldreg USES ds si di, @@reg:WORD, @@page:WORD, @@disp:WORD
  330.     push    ds            ; Assume es = ds
  331.     pop    es
  332.     mov    di, [@@reg]
  333.     mov    bx, [@@page]
  334.     mov    si, [@@disp]
  335.     shl    bx, 1            ; Point ds:si to Scheme pointer
  336.     ldpage    ds, bx
  337.     cld
  338.     lodsb                ; Load pointer's page field
  339.     xor    ah, ah
  340.     mov    [(REG es:di).page], ax
  341.     lodsw                ; Load displacement field
  342.     mov    [(REG es:di).disp], ax
  343.     ret
  344. ENDP    ldreg
  345.  
  346. ;************************************************************************
  347. ;*        Set the cdr field of a list cell            *
  348. ;* Calling sequence: asetcdr(creg, preg)                *
  349. ;* Where creg:    register pointing to cell                *
  350. ;*    preg:    register holding new pointer                *
  351. ;************************************************************************
  352. PROC C    asetcdr    USES si di, @@list:WORD, @@cdr:WORD
  353.     mov    di, [@@list]
  354.     mov    bx, [(REG di).page]
  355.     mov    di, [(REG di).disp]
  356.     ldpage    es, bx
  357.     add    di, OFFSET (TYPE LISTDEF).cdr
  358.     mov    si, [@@cdr]
  359.     cld
  360.     mov    ax, [(REG si).page]
  361.     stosb
  362.     mov    ax, [(REG si).disp]
  363.     stosw
  364.     ret
  365. ENDP    asetcdr
  366.  
  367. ;************************************************************************
  368. ;*        Copy bytes from one C location to another        *
  369. ;* Calling sequence: str2str(dest_adr, src_adr, n)            *
  370. ;* Where dest_adr:destination address                    *
  371. ;*    src_adr:source address                        *
  372. ;*    n:    number of bytes to copy                    *
  373. ;************************************************************************
  374. PROC C    str2str    USES si di, @@dest:WORD, @@source:WORD, @@len:WORD
  375.     push    ds            ; Assume es = ds
  376.     pop    es
  377.     mov    di, [@@dest]
  378.     mov    si, [@@source]
  379.     mov    cx, [@@len]
  380.     cld
  381.     rep    movsb
  382.     ret
  383. ENDP    str2str
  384.  
  385. ;************************************************************************
  386. ;*    Adjust window region variables for presence of a border        *
  387. ;* Calling sequence: adj4bord(&ull, &nl, &ulc, &nc)            *
  388. ;* Where ull:    Upper-left-line variable                *
  389. ;*     nl:    Number-of-lines variable                *
  390. ;*    ulc:    Upper-left-column variable                *
  391. ;*    nc:    Number-of-columns variable                *
  392. ;************************************************************************
  393. PROC C    adj4bord USES si di, @@ull:WORD, @@nl:WORD, @@ulc:WORD, @@nc:WORD
  394.     call    get_max_rows C        ; Expand HEIGHT of window region
  395.     mov    si, [@@ull]
  396.     mov    di, [@@nl]
  397. @@backward:
  398.     mov    bx, ax
  399.     mov    ax, [si]        ; Get value of upper-left parm
  400.     or    ax, ax            ; If minimum, don't expand
  401.     jz    @@forward
  402.     dec    [WORD si]        ; Else, expand backward
  403.     inc    [WORD di]
  404.     dec    ax            ; Adjust ax to match upper-left parm
  405. @@forward:
  406.     add    ax, [di]        ; Find opposite edge
  407.     cmp    ax, bx            ; If edge too far, don't expand
  408.     jae    @@nextsides
  409.     inc    [WORD di]        ; Else, expand forward
  410. @@nextsides:
  411.     call    get_max_cols C
  412.     dec    ax
  413.     cmp    bx, ax            ; Finished ?
  414.     je    @@return
  415.     mov    si, [@@ulc]        ; Else, expand WIDTH of window region
  416.     mov    di, [@@nc]
  417.     jmp    @@backward
  418. @@return:
  419.     ret
  420. ENDP    adj4bord
  421.  
  422.     END
  423.